package XNAT::DICOM::File;
@ISA = ('XNAT::DICOM::Entity');

use strict;
use Image::ExifTool qw(:Public);
use Carp qw(croak carp cluck confess);
use Cwd qw( abs_path getcwd );
use File::Basename;
use Digest::MD5 qw(md5 md5_hex md5_base64);

require XNAT::DICOM::Series;
require XNAT::DICOM::Session;

# Used to keep track of previously loaded information.
my %loaded_by_file;
my %loaded_by_uid;
my %loaded_by_label;

=head1 XNAT::DICOM::File

XNAT::DICOM::File - More or less what you think it is.

=head2 EXAMPLE USAGE

 my $dicom = XNAT::DICOM::File->new($file);


=head2 STATIC METHODS

=over 4

=item XNAT::DICOM::File::getAll();

Get all files ever instatiated with this class (during the current script's execution, of course).

=cut

sub getAll { shift if ref $_[0]; values %loaded_by_uid; }

=item XNAT::DICOM::File::getByFile($full_path_and_filename);

Guess. Returns undef if it has not been loaded or does not exist.

=cut

sub getByFile { shift if ref $_[0]; $loaded_by_file{shift(@_)}; }

=item XNAT::DICOM::File::getByUid($uid);

Get a file by its DICOM UID as defined in the 'InstanceNumber' DICOM Header.
Returns undef if it has not been loaded or does not exist.

=cut

sub getByUid { shift if ref $_[0]; $loaded_by_uid{shift(@_)}; }

=item XNAT::DICOM::File::getById($id);

Get a file by its Internal ID as defined by

 "${XNAT_label}_series_${formatted_series_number}_file_${formatted_file_number}",

which is the same as

 "${DICOM_PatientsName}_series_".
 sprintf('%03d',${DICOM_SeriesNumber}.
 "_file_".sprintf('%03d',${DICOM_InstanceNumber}

Returns undef if it has not been loaded or does not exist.

=cut

sub getById { shift if ref $_[0]; $loaded_by_label{shift(@_)}; }

sub _addLoaded {
  my $self = shift || confess "Wrong number of args. ";
  my $uid = $self->{uid};
  my $label = $self->{label};
  my $errors = "";
  $errors .=  "ERROR: File Filename '$self->{fullpath_filename}' already Exists.\n" if $loaded_by_file{$self->{fullpath_filename}};
  if ( $loaded_by_uid{$uid} ) {
    my $previous = $loaded_by_uid{$uid};
    $errors .=  "ERROR: File UID '$uid' already Exists.\n";
    $errors .=  "ERROR:  - File 1 '$self->{fullpath_filename}'.\n";
    $errors .=  "ERROR:  - File 2 '$previous->{fullpath_filename}'.\n";
  }
  if ( $loaded_by_label{$label} ) {
    # Normally, this would have been a fatal error, but Thomas' and Ross' experimental
    # sequences break this, so I removed the check.
    my $previous = $loaded_by_label{$label};
    my $count = 0;
    while($previous = $loaded_by_label{$label}) {
      $label = "$self->{label}_$count";
      $count++;
    }
    $self->{label} = $label;
    #$errors .=  "ERROR: File Internal ID '$label' already Exists.\n";
    #$errors .=  "ERROR:  - File 1 '$self->{fullpath_filename}'.\n";
    #$errors .=  "ERROR:  - File 2 '$previous->{fullpath_filename}'.\n";
  }
  confess $errors if $errors;
  $loaded_by_file{$self->{fullpath_filename}} = $self;
  $loaded_by_uid{$uid} = $self;
  $loaded_by_label{$label} = $self;
}


=back

=cut

=head2 INSTANCE METHODS

=over 4

=item XNAT::DICOM::File->new($file)

Returns a new Session object. Can be called like so:

 my $dicom = XNAT::DICOM::File->new($file);

Where $file is the path and filename of the DICOM file to load.

=cut

sub new {
  my $class = shift;
  my $self = {file=>'',warnings=>{},errors=>{},size_on_disk=>0,uncompressed_size=>0,};
  bless $self,$class;
  if (@_) {
    my $file = shift;
    # Don't load the same file twice, but return the previously loaded XNAT::DICOM::File
    if ( getByFile($file) ) {
      return getByFile($file);
    }
    $self->file($file);
  }
  # Remember to return the $self at the end!
  $self;
}

=item $dcmfile->file($filename)

Get or set file attribute. If no $filename is provided just returns the current value. If $filename is provided, it will load the DICOM header information for that file and perform any checks and "to XNAT" translations.

=cut

sub file {
  my $self = shift;
  if (@_) {
    my $filename = shift;
    $self->{fullpath_filename} = abs_path($filename);
    # Don't load the same file twice, for now a fatal error.
    if ( getByFile($self->{fullpath_filename}) ) {
      confess "ERROR: Attempt to reload file.\n";
    }
    # If this is renaming a file, we should deal with it here.
    if ($self->{original_file_path}) {
      delete $loaded_by_file{$self->{original_file_path}};
      confess "ERROR: Sorry, renaming a file is not implemented yet!\n";
    }
    $self->{original_file_path} = $self->{fullpath_filename};
    if (! -e $self->{fullpath_filename}) {
      confess "ERROR: No such DICOM file '$self->{fullpath_filename}'\n";
    }
    if (! -f $self->{fullpath_filename}) {
      $self->addErrors("'$self->{fullpath_filename}' is not a regular file.\n");
      return undef;
    }
    if ($self->{fullpath_filename} =~ m/(\.dcm$|\.dcm\.gz$)/i) {
      $self->{suffix} = $1;
    } else {
      $self->addErrors("'$self->{fullpath_filename}' does not appear to be a DICOM file.\n");
      return undef;
    }
    $self->_load_dcm_headers();
    $self->_check_dcm_headers();
    $self->_convert_to_xnat_parameters();
    #$self->_check_xnat_parameters();
    $self->_addLoaded();
    $self->_updateFullPathFilename;
    $self->{series}->addDicomFile($self);
  }
  $self->{fullpath_filename};
}

sub _updateFullPathFilename {
  my $self = shift;
  if ( $self->{fullpath_filename} =~ m{^(.*)/(.*?)$} ) {
    $self->{directory} = $1;
    $self->{prearchive_dir} = $1;
    $self->{basename} = $2;
  } else {
    confess "FATAL ERROR: Unable to determine directory for '$self->{fullpath_filename}'!\n";
  }
  # If the "prearchive_dir" is in the RAW dir, we want one level up.
  $self->{prearchive_dir} =~ s{/RAW/?}{};
  $self->{headers}->{XNATPreArchiveDirectory} = $self->{prearchive_dir};
  $self->{series}->{directory} = $self->{directory};
  $self->{series}->{catalog_directory} = $self->{prearchive_dir};
  my $tmp_re = quotemeta($self->{prearchive_dir});
  $self->{catalog_filename} = $self->{fullpath_filename};
  $self->{catalog_filename} =~ s{^$tmp_re/*}{};
  $self->{fullpath_filename};
}

sub _load_dcm_headers {
  my $self = shift;
  $self->debug(2,"_load_dcm_headers: Loading DICOM Headers from '$self->{fullpath_filename}'\n");
  $self->{size_on_disk} = -s $self->{fullpath_filename};
  if ($self->{fullpath_filename} =~ m/\.dcm.gz$/) {
    my $outfile = "";
    my $size = 0;
    $self->debug(3,"_load_dcm_headers: Unzipping file.\n");
    open(GZIP,"gunzip -c \"$self->{fullpath_filename}\" |") || die "ERROR: Unable to run 'gunzip -c \"$self->{fullpath_filename}\"': $!\n";
    while (<GZIP>) {
      $outfile .= $_;
    }
    close(GZIP);
    $self->{uncompressed_md5_checksum} = md5_hex($outfile);
    $self->debug(3,"_load_dcm_headers: Loading unzipped file.\n");
    $self->{uncompressed_size} = length($outfile);
    $self->{headers} = ImageInfo(\$outfile);
  } else {
    $self->debug(3,"_load_dcm_headers: Loading file.\n");
    $self->{uncompressed_size} = $self->{size_on_disk};
    $self->{headers} = ImageInfo("$self->{fullpath_filename}");
    open(FILE, $self->{fullpath_filename}) or die "Can't open '$self->{fullpath_filename}' for reading: $!";
    binmode(FILE);
    $self->{uncompressed_md5_checksum} = Digest::MD5->new->addfile(*FILE)->hexdigest;
    close FILE;
  }

  # We need to remove trailing whitespace since it seems to pop up everywhere
  # and reek havoc on numerous items.
  foreach my $header ( keys %{$self->{headers}} ) {
    $self->{headers}->{$header} =~ s/[\s\r\f\t ]+$//;
  }

  # Use this for sorting as needed.
  $self->{file_number}   = sprintf('%03d',$self->{headers}->{InstanceNumber});

  # Check and see if we've loaded this DICOM image file before as identified by its UID
  $self->{uid} = $self->{headers}->{MediaStorageSOPInstanceUID};
  my $previous_dcm = getByUid($self->{uid});
  if ($previous_dcm) {
    my $identical = 1;
    my %all_headers = (%{$self->{headers}},%{$previous_dcm->{headers}});
    foreach my $header (keys %all_headers ) {
      if (! exists $self->{headers}->{$header} ||
	  ! exists $previous_dcm->{headers}->{$header} ||
	  $self->{headers}->{$header} ne $previous_dcm->{headers}->{$header} ) {
	$identical = 0;
				# No need to do more
	last;
      }
    }
    if ($identical) {
      $self->addErrors("'$self->{fullpath_filename}' is the SAME DICOM as the previously loaded '$previous_dcm->{fullpath_filename}'.\n");
      $previous_dcm->addWarnings("'$previous_dcm->{fullpath_filename}' is the SAME DICOM as the previously loaded '$self->{fullpath_filename}'.\n");
    } else {
      $self->addErrors("'$self->{fullpath_filename}' has the SAME UID as the previously loaded '$previous_dcm->{fullpath_filename}', but their headers are not identical!\n");
      $previous_dcm->addWarnings("'$previous_dcm->{fullpath_filename}' has the SAME UID as the previously loaded '$self->{fullpath_filename}', but their headers are not identical!\n");
    }
  }
  # Get sessions and series for this DICOM.
  $self->{series}  = XNAT::DICOM::Series->new($self);
  $self->{session} = $self->{series}->{session};
  $self->{label} = $self->{series}->{label} . "_file_" . $self->{file_number};

  # Update info for the sessions / series.
  $self->{series}->{size_on_disk} += $self->{size_on_disk};
  $self->{session}->{size_on_disk} += $self->{size_on_disk};
  $self->{series}->{uncompressed_size} += $self->{uncompressed_size};
  $self->{session}->{uncompressed_size} += $self->{uncompressed_size};

  $self->debug(2,"_load_dcm_headers: Done Loading file (size='$self->{uncompressed_size}', label='$self->{label}').\n");

  # Return success (always).
  1;
}

=item $dcmfile->getHeader($header)

Get the DICOM header value for this image file. Returns value or undef.

=cut

sub getHeader { my($self,$header) = @_;$self->{headers}->{$header}; }

=item $dcmfile->setHeader($header,$value)

Set the DICOM header value for this image file. For now, setting an existing value causes a fatal error.

=cut

sub setHeader {
  my($self,$header,$value,$xtra) = @_;
  if ($xtra) {
    confess "ERROR: Wrong numbre of arguments!\n";
  }
  if ( exists $self->{headers}->{$header} ) {
    $self->addErrors("You are not allowed to reset '$header' to '$value', since it is an existing DICOM header!\n");
  }
  $self->{headers}->{$header} = $value;
}


=item $dcmfile->getUid()

Get the DICOM UID for this image file.

=cut

sub getUid { $_[0]->{uid}; }

=item $dcmfile->getSliceOrientation()

Get the calculated orientation of the image slice.
Returns 'Tra','Sag','Cor' or '' if we could not compute it or it was not computed for some reason.

=cut

sub getSliceOrientation { getHeader($_[0],'XNATSliceOrientation'); }

=item $dcmfile->setSliceOrientation()

Set the calculated orientation of the image slice. Should be one of 'Tra','Sag','Cor' or ''

=cut

sub setSliceOrientation {
  my ($self,$value,$xtra) = @_;
  if ($xtra) {
    confess "ERROR: Wrong numbre of arguments!\n";
  }
  $self->setHeader('XNATSliceOrientation',$value);
  $self->getSeries()->setSliceOrientation($value);
}

=item $dcmfile->getFullPathFilename()

Returns the full path and filename of the DICOM file.

=cut

sub getFullPathFilename { $_[0]->{fullpath_filename}; }

=item $dcmfile->getFileBasename()

Returns the basename of the DICOM file.

=cut

sub getFileBasename { $_[0]->{basename}; }

=item $dcmfile->getDirectory()

Returns the directory in which the DICOM file is located.

=cut

sub getDirectory { $_[0]->{directory}; }

=item $dcmfile->getPrearchiveDirectory()

Returns the best guess as to what is the PreArchive directory of the DICOM file.

=cut

sub getPreArchiveDirectory { $_[0]->{prearchive_dir}; }

=item $dcmfile->getSizeOnDisk()

Returns the size of the file on disk, thus compressed files are smaller.

=cut

sub getSizeOnDisk { $_[0]->{size_on_disk}; }

=item $dcmfile->getDICOMSize()

Returns the size of the uncompressed DICOM file (same as $dcmfile->getSizeOnDisk() if the file was not compressed to begin with).

=cut

sub getDICOMSize { $_[0]->{uncompressed_size}; }

=item $dcmfile->getSeries()

Get the XNAT::DICOM::Series object to which this file belongs.

=cut

sub getSeries { $_[0]->{series}; }

=item $dcmfile->getSession()

Get the XNAT::DICOM::Session object to which this file belongs.

=cut

sub getSession { $_[0]->{session}; }

sub _calculate_slice_orientation {
  # should probably move this up to the Series to speed things up, since we should not have to calculate it for every file.
  my $self = shift;
  if ( $self->getHeader('ImageOrientationPatient') ) {
    my($x1,$y1,$z1,$x2,$y2,$z2,$more) = split(/\\+/,$self->{headers}->{ImageOrientationPatient});
    if ( (! defined $z2) || $more) {
      $self->addWarnings("DICOM Header ImageOrientationPatient = '$self->{headers}->{ImageOrientationPatient}' is malfrmed.");
    } elsif ( abs( ($x1*$x2) + ($y1*$y2) + ($z1*$z2) ) > 0.001 ) {
      # Consistency Check of some sort, no idea how the math works, but
      # saw it in some other coded libs, so monkey see, monkey do.
      $self->addWarnings("DICOM Header ImageOrientationPatient = '$self->{headers}->{ImageOrientationPatient}' does not make math sense.");
      $self->setSliceOrientation('');
    } elsif ( abs( 1 - ($x1*$x1) - ($y1*$y1) - ($z1*$z1) ) > 0.001 ||
	      abs( 1 - ($x2*$x2) - ($y2*$y2) - ($z2*$z2) ) > 0.001 ) {
      # Another consistency Check of some sort, no idea how the math works, but
      # saw it in some other coded libs, so monkey see, monkey do.
      $self->addWarnings("DICOM Header ImageOrientationPatient = '$self->{headers}->{ImageOrientationPatient}' does not make math sense to me.");
      $self->setSliceOrientation('');
    } else {
      # From Kevin Archie: Cross product gives direction of normal to image plane
      my $xn = abs( ($y1 * $z2) - ($y2 * $z1) );
      my $yn = abs( ($z1 * $x2) - ($z2 * $x1) );
      my $zn = abs( ($x1 * $y2) - ($x2 * $y1) );
      # From Kevin Archie: patient's body length is Z, ventral-dorsal is Y, and right-left is Z,
      # so image plane normal along X->sagittal, Y->coronal, Z->transverse
      if ($xn > $yn) {
	if ($xn > $zn) {
	  $self->setSliceOrientation('Sag');
	} else {
          $self->setSliceOrientation('Tra');
	}
      } else {
	if ($xn > $zn) {
          $self->setSliceOrientation('Cor');
	} else {
          $self->setSliceOrientation('Tra');
	}
      }
    }
  } else {
    if ($self->{headers}->{SeriesDescription} ne 'PhoenixZIPReport' &&
	$self->{headers}->{SeriesDescription} ne 'DIFFUSION_ColorFA' &&
	$self->{headers}->{SeriesDescription} ne 'DIFFUSION_ColorFA ' ) {
      $self->addWarnings("DICOM Header ImageOrientationPatient is missing.");
      # Return false, since thre was an issue
      return 0;
    }
  }
  # Return true.
  1;
}

sub _convert_to_xnat_parameters {
  my $self = shift;
  $self->_calculate_slice_orientation();
  if ($self->{headers}->{PixelSpacing}) {
    my ($x,$y,$huh) = split(/\\/,$self->{headers}->{PixelSpacing});
    if (!$x || !$y || $huh) {
      $self->addWarnings("Unable to determine x and y resolutions correctly from PixelSpacing='$self->{headers}->{PixelSpacing}'!");
    }
    $self->{headers}->{'XResolution'} = $x;
    $self->{headers}->{'YResolution'} = $y;
    $self->{series}->{'XResolution'} = $x;
    $self->{series}->{'YResolution'} = $y;
  }
  # Return true.
  1;
}

sub _check_dcm_headers {
  my $self = shift;
  $self->debug(3,"_check_dcm_headers: Checking DICOM Headers from '$self->{fullpath_filename}'\n");
  if ( defined $self->{headers}->{PatientsBirthDate} && $self->{headers}->{PatientsBirthDate} !~ /01:01$/) {
    $self->addErrors( sprintf("HIPAA: Subj:%25s DOB='%s'\n",$self->{headers}->{PatientsName},$self->{headers}->{PatientsBirthDate}) );
  }
}

sub localMoveTo {
  my $self = shift;
  my $destination_directory = shift || confess "Wrong Args!";
  my $current_fullpath_filename = $self->getFullPathFilename();
  my $current_directory = $self->getDirectory();
  my $current_basename = $self->getFileBasename();
  my @errors;
  push @errors, "Directory '$current_directory' is not writable.\n" unless -w $current_directory;
  push @errors, "Directory '$destination_directory' is not writable.\n" unless -w $destination_directory;
  if (@errors) {
    $self->addErrors(@errors);
    confess $self->getWarnings(),$self->getErrors(), "FATAL ERROR: Cannot move $current_basename from $current_directory to $current_basename!\n";
  }
  my $new_fullpath_filename = $destination_directory."/".$self->{label}.".dcm";
  #my $new_fullpath_filename = $destination_directory."/".$current_basename;
  rename ($current_fullpath_filename,$new_fullpath_filename) or
    confess $self->getWarnings(),$self->getErrors(), "FATAL ERROR: Cannot move $current_basename from $current_directory to $current_basename!\nREASON: $!\n";
  delete $loaded_by_file{$self->{fullpath_filename}};
  $self->{fullpath_filename} = $new_fullpath_filename;
  $loaded_by_file{$self->{fullpath_filename}} = $self;
  $self->_updateFullPathFilename;
}

=back

=cut

1;

__END__
